Shareware Grab Bag/Shareware Grab Bag.iso/003/mailmen5.arc/MAILMEN5.PRG

Text File | 1985-08-18 | 28.5 KB | 1,182 lines

* PROGRAM IS CALLED MAILMEN5.PRG-- IT HANDLES ALL SUB PROGRAMS TO OPERATE
* MAILING LISTS. COPYRIGHT JULY 30,1985 BY PHILIP K. PERLMAN
PROC MAILMEN5
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR ALL
RESTORE FROM MAILSET
SET BELL &BEEP
SET DELIMITER OFF
SET COLOR TO &COLR
DO WHILE .T.
CLEAR
RESTORE FROM MAILSET
SET COLOR TO &COLR
SET BELL &BEEP
SET DEFAULT TO &DRV
SET PATH TO &MPATH
STORE DRV-':'-TRIM(MPATH)-'\'-'MAIL.DBF' TO TEST1
STORE DRV-':'-TRIM(MPATH)-'\'-'LAST.NDX' TO TEST2
STORE DRV-':'-TRIM(MPATH)-'\'-'COMP.NDX' TO TEST3
STORE DRV-':'-TRIM(MPATH)-'\'-'PROF1.NDX' TO TEST4
IF .NOT. (FILE(TEST1) .AND. FILE(TEST2) .AND. FILE(TEST3);
 .AND. FILE(TEST4))
   CLEAR
   TEXT


                                 ATTENTION
                                 =========

           DATA BASE AND INDEX FILES CANNOT BE FOUND. USE MAIN MENU
           ITEM 9 TO SET THE CORRECT PATH AND DISK DRIVE WHERE THESE
           FILES ARE TO BE LOCATED.

           PRESS ANY KEY TO CONTINUE
   ENDTEXT
   SET CONSOLE OFF
   WAIT
   SET CONSOLE ON
   CLEAR
ENDIF
STORE  ' ' TO NEXT
* MAILMENU.PRG ----MENU PROGRAM FOR MAILMEN PROGRAM BY PHILIP PERLMAN
* COPYRIGHT AUGUST 9,1985
*
@ 1,9     SAY "+==============================================================+"
@ 2,9     SAY "|                                                              |"
@ 3,9     SAY "|                        MAILING LIST                          |"
@ 4,9     SAY "|                                                              |"
@ 5,9     SAY "|                        MASTER  MENU                          |"
@ 6,9     SAY "|                                                              |"
@ 7,9     SAY "|                                                              |"
@ 8,9     SAY "|==============================================================|"
@ 9,9     SAY "|  1> Add Names To File                                        |"
@ 10,9     SAY "|  2> View / Edit / Delete Records                             |"
@ 11,9     SAY "|  3> View / Print Names & Telephone #'s by Category           |"
@ 12,9     SAY "|  4> Print Files on Rolodex Cards By Category                 |"
@ 13,9     SAY "|  5> Print Mailing Labels By Category                         |"
@ 14,9     SAY "|  6> Print Indices to Categories                              |"
@ 15,9     SAY "|  7> Christmas Mailing                                        |"
@ 16,9     SAY "|  8> Birthday Mailing                                         |"
@ 17,9     SAY "|  9> Change Default Settings                                  |"
@ 18,9     SAY "|  P> Purge files                                              |"
@ 19,9     SAY "|                       E> EXIT PROGRAM TO DBASE               |"
@ 20,9     SAY "|                       Q> EXIT PROGRAM TO DOS                 |"
@ 21,9     SAY "|                                                              |"
@ 22,9     SAY "|                    PLEASE CHOOSE ONE OPTION:                 |"
@ 22,55 GET NEXT
@ 23,9     SAY "+==============================================================+"
READ
CLEAR GETS
   IF VAL(NEXT) = 1
     CLOSE FORMAT
     DO MAILINP
   ELSE
   IF VAL(NEXT) = 2
     CLOSE FORMAT
     DO MAILED
   ELSE
   IF VAL(NEXT) = 3
     CLOSE FORMAT
     DO MAILCAT
   ELSE
   IF VAL(NEXT) = 4
     CLOSE FORMAT
     DO MAILROL
   ELSE
   IF VAL(NEXT) = 5
     CLOSE FORMAT
     DO MAILAB
   ELSE
   IF VAL(NEXT) = 6
      CLOSE FORMAT
      DO MAILIND
   ELSE
   IF VAL(NEXT) = 7
     CLOSE FORMAT
     DO MAILXMAS
   ELSE
   IF VAL(NEXT) = 8
     CLOSE FORMAT
     DO MAILBIRT
   ELSE
   IF VAL(NEXT) = 9
     CLOSE FORMAT
     DO MAILSET
   ELSE
   IF UPPER(NEXT) = 'P'
     CLOSE FORMAT
     DO MAILDEL
   ELSE
   IF UPPER(NEXT) = 'E'
     CLOSE FORMAT
     RELEASE NEXT, GO, CHANGE, TEST1, TEST2, TEST3, TEST4
     SAVE TO MAILSET
     CLEAR ALL
     RETURN
   ELSE
   IF UPPER(NEXT) = 'Q'
      CLOSE FORMAT
      RELEASE NEXT, GO, CHANGE, TEST1, TEST2, TEST3, TEST4
      SAVE TO MAILSET
      CLEAR ALL
      QUIT
    ELSE
       LOOP
    ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
   ENDDO
PROC MAILINP
* THIS PROGRAM IS CALLED MAILINP.PRG-- MASTER PROGRAM FOR INPUT OF DATA TO
* MAILING LIST PROGRAM COPYRIGHT JULY 31, 1985 BY PHILIP K. PERLMAN
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
SET TALK OFF
STORE .T. TO CONTINUE
DO WHILE CONTINUE
STORE 0 TO MAINMEN
STORE 0 TO MREC1
USE MAIL INDEX LAST, COMP, PROF1
APPEND BLANK
STORE RECNO() TO MREC1
STORE .T. TO FMT
DO WHILE FMT
* MAILGET.PRG SCREEN FOR USE WITH MAILMEN.PRG COPYRIGHT JAN. 1985 PHILIP
* PERLMAN
@ 1,0 SAY '+==================='
@ 1,20 SAY '===================='
@ 1,40 SAY '===================='
@ 1,60 SAY '==================+'
@ 2,0 SAY '|'
@ 2,27 SAY 'ADD INFORMATION BELOW'
@ 2,78 SAY '|'
@ 3,0 SAY '|'
@ 3,20 SAY 'Check your entries before continuing.'
@ 3,78 SAY '|'
@ 4,0 SAY '|==================='
@ 4,20 SAY '===================='
@ 4,40 SAY '===================='
@ 4,60 SAY '==================|'
@ 5,0 SAY '|   Company'
@ 5,13 GET company PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 5,78 SAY '|'
@ 6,0 SAY '|   First'
@ 6,13 GET first PICTURE '!!!!!!!!!!!!!!!!!!!!'
@ 6,34 SAY 'Last'
@ 6,39 GET last PICTURE '!!!!!!!!!!!!!!!!!!!!'
@ 6,78 SAY '|'
@ 7,0 SAY '|   Addr1'
@ 7,13 GET addr1 PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 8,0 SAY '|   Addr2'
@ 8,13 GET addr2 PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 9,0 SAY '|   City'
@ 9,13 GET city PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 9,39 SAY 'State'
@ 9,45 GET state PICTURE '!!'
@ 9,50 SAY 'Zip'
@ 9,54 GET zip PICTURE '!!!!!'
@ 9,78 SAY '|'
@ 7,55 SAY 'Friend (Y/N)'
@ 7,70 GET friend PICTURE '!'
@ 7,78 SAY '|'
@ 8,55 SAY 'Business (Y/N)'
@ 8,70 GET bus_xmas PICTURE '!'
@ 8,78 SAY '|'
@ 10,0 SAY '|'
@ 10,78 SAY '|'
@ 11,0 SAY '|            Business Telephones'
@ 11,43 SAY 'Other Telephones'
@ 11,64 SAY 'Location      |'
@ 12,0 SAY '|'
@ 12,13 GET Tel_wrk PICTURE '999-999-9999'
@ 12,28 SAY 'Ext.'
@ 12,33 GET ext1
@ 12,43 GET tel_hm PICTURE '999-999-9999'
@ 12,64 GET loc1 PICTURE '!!!!!!!!!!'
@ 12,78 SAY '|'
@ 13,0 SAY '|'
@ 13,13 GET tel_wrk2 PICTURE '999-999-9999'
@ 13,28 SAY 'Ext.'
@ 13,33 GET ext2
@ 13,43 GET tel_hm2 PICTURE '999-999-9999'
@ 13,64 GET loc2 PICTURE '!!!!!!!!!!'
@ 13,78 SAY '|'
@ 14,0 SAY '|'
@ 14,13 GET tel_wrk3 PICTURE '999-999-9999'
@ 14,28 SAY 'Ext.'
@ 14,33 GET ext3
@ 14,43 GET tel_hm3 PICTURE '999-999-9999'
@ 14,64 GET loc3 PICTURE '!!!!!!!!!!'
@ 14,78 SAY '|'
@ 15,0 SAY '|'
@ 15,78 SAY '|'
@ 16,0 SAY '|   Category'
@ 16,13 GET prof1 PICTURE '!!!!!!!!!!!!!!!!!!!!'
@ 16,35 SAY 'Birthday'
@ 16,44 GET birthday PICTURE '99/99/99'
@ 16,78 SAY '|'
@ 17,0 SAY '|'
@ 17,78 SAY '|'
@ 18,0 SAY '|'
@ 18,78 SAY '|'
@ 19,0 SAY '|   Comment'
@ 19,13 GET mcom1
@ 19,78 SAY '|'
@ 20,0 SAY '|'
@ 20,13 GET mcom2
@ 20,78 SAY '|'
@ 21,0 SAY '|'
@ 21,78 SAY '|'
@ 22,0 SAY '+==================='
@ 22,20 SAY '===================='
@ 22,40 SAY '===================='
@ 22,60 SAY '==================+'
@ 23,11 SAY "TO CONTINUE PRESS <ENTER> SEVERAL TIMES OR CONTROL W <^W)"
READ
CLEAR GETS
STORE .T. TO REVIEW
DO WHILE REVIEW
CLEAR
@ 10,5 SAY "Are all you entries correct ?"
@ 12,5 SAY "Press 'R' to review and correct your entries"
@ 14,5 SAY "Press 'Y' to write your entries into the record"
@ 16,5 SAY "Press 'M' to abort entries and return to the menu"
?
?
?
WAIT TO ANS
IF UPPER(ANS) <> 'R' .AND. UPPER(ANS) <> 'Y' .AND. UPPER(ANS) <> 'M'
CLEAR
LOOP
ELSE
STORE .F. TO REVIEW
ENDIF
ENDDO
IF UPPER(ANS) = 'R'
CLEAR GETS
CLEAR
LOOP
ELSE
IF UPPER(ANS) = 'Y'
STORE .F. TO FMT
CLEAR
ELSE
STORE .F. TO FMT
CLEAR
SET DEVICE TO SCREEN
     USE
     USE MAIL INDEX LAST, COMP, PROF1
     GOTO MREC1
     DELE
     RELEASE FMT, REVIEW, ANS, FORMAT,
     RETURN
ENDIF
ENDIF
ENDDO
CLEAR
@ 10,5 SAY 'Do you want to add more records ?'
@ 12,5 SAY "Press 'M' to return to the menu"
@ 14,5 SAY 'Press any other key to continue'
?
?
?
?
WAIT TO ANSWER
IF UPPER(ANSWER) = 'M'
   CLEAR
  @ 10,5 SAY "...PROCESSING ENTRIES..."
  USE
   STORE .F. TO CONTINUE
   RETURN
ENDIF
DO MAILMSG
ENDDO
RETURN
* MAILED.PRG - PROGRAM FOR EDITING MAILIST FILES
* COPYRIGHT AUGUST 9, 1985 BY PHILIP K. PERLMAN
PROC MAILED
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
DO MAILMSG
PRIVATE ALL
STORE .T. TO ED
DO WHILE ED
STORE ' ' TO ANS
STORE ' ' TO ANS1
STORE .T. TO CHOICE
DO WHILE CHOICE
CLEAR
? "YOU CAN LOCATE THE FILE BY THE INDIVIDUAL'S NAME OR COMPANY NAME"
?
?
?
ACCEPT "ENTER LAST NAME: " TO NAME
?
?
?
?
ACCEPT "ENTER FIRST NAME: " TO NAME1
?
?
?
?
ACCEPT "ENTER COMPANY NAME: " TO COMP
STORE ' ' TO CHOSE
@ 18,7 say "+----------------------------------------------------------------+"
@ 19,7 Say "| Select: <M>enu                ** Any Other Key To Continue **  |"
@ 20,7 say "+----------------------------------------------------------------+"
@ 19,25 GET CHOSE
READ
CLEAR GETS
     IF UPPER(CHOSE) = 'M'
       STORE .F. TO CHOICE
       STORE .F. TO DULY
       STORE .F. TO ED
       STORE 2 TO REC
    ELSE
       STORE UPPER(NAME) TO NAME
       STORE UPPER(NAME1) TO NAME1
       STORE UPPER(COMP) TO COMP
       STORE .T. TO DULY
       STORE .F. TO CHOICE
     ENDIF
ENDDO CHOICE
DO WHILE DULY
IF LEN(COMP) = 0 .AND. LEN(NAME) <> 0 .AND. LEN(NAME1) <> 0
     USE MAIL INDEX LAST, COMP, PROF1
     SEEK NAME
          IF .NOT. EOF()  .AND. .NOT. DELETED()
             STORE .T. TO SEARCH
             DO WHILE SEARCH .AND. .NOT. EOF()
                IF FIRST = NAME1
                     STORE 1 TO REC
                     STORE .F. TO SEARCH
                     STORE .F. TO DULY
                ELSE
                SKIP
                ENDIF
             ENDDO SEARCH
           ENDIF
           IF EOF() .OR. DELETED()
              STORE 0 TO REC
              STORE .F. TO DULY
           ENDIF
ELSE
IF LEN(COMP) = 0 .AND. LEN(NAME) <> 0 .AND. LEN(NAME1) = 0
     USE MAIL INDEX LAST, COMP, PROF1
     SEEK NAME
          IF EOF() .OR. DELETED()
                STORE 0 TO REC
                STORE .F. TO DULY
          ELSE
                STORE 1 TO REC
                STORE .F. TO DULY
          ENDIF
ELSE
     USE MAIL INDEX COMP, LAST, PROF1
     SEEK COMP
          IF EOF() .OR. DELETED()
               STORE 0 TO REC
               STORE .F. TO DULY
          ELSE
               STORE 1 TO REC
               STORE .F. TO DULY
          ENDIF
ENDIF
ENDIF
ENDDO DULY
IF REC = 0
     CLEAR
     STORE ' ' TO ANS3
     @ 10,5 SAY "Record Cannot Be Found."
     @ 12,5 say "Press 'M' to Return to the Menu"
     @ 14,5 SAY "Press Any Other Key to Try Again."
     @ 14,70 get ANS3
     READ
     CLEAR GETS
          IF UPPER(ANS3) = 'M'
                    STORE .F. TO ED
                    STORE .F. TO DULY
                    RETURN
          ELSE
                    STORE .T. TO DULY
                    STORE ' ' TO ANS
          ENDIF
ENDIF
DO WHILE REC = 1
STORE ' ' TO ANS
CLEAR
@ 1,0 SAY 'Company'
@ 3,0 SAY 'Name'
@ 4,45 SAY 'Friend (Y/N)'
@ 5,45 SAY 'Business (Y/N)'
@ 8,10 SAY 'Business Telephones'
@ 8,43 SAY 'Other Telephones'
@ 8,64 SAY 'Location'
@ 9,25 SAY 'Ext.'
@ 10,25 SAY 'Ext.'
@ 11,25 SAY 'Ext.'
@ 13,0 SAY 'Category'
@ 13,35 SAY 'Birthday'
@ 16,0 SAY 'Comment'
@ 19,5 SAY "+--------------------------------------------------------------+"
@ 20,5 SAY "| SELECT: <N>ext  <P>rior  <E>dit  <D>elete  <F>ind   <M>enu   |"
@ 21,5 SAY "+--------------------------------------------------------------+"
STORE .T. TO TRUE
DO WHILE TRUE
@ 1,10 GET company PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 3,10 GET last PICTURE '!!!!!!!!!!!!!!!!!!!!'
@ 3,32 GET first PICTURE '!!!!!!!!!!!!!!!!!!!!'
@ 4,10 GET addr1 PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 5,10 GET addr2 PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 6,10 GET city PICTURE '!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 6,37 GET state PICTURE '!!'
@ 6,41 GET zip PICTURE '!!!!!'
@ 4,60 GET friend PICTURE '!'
@ 5,60 GET bus_xmas PICTURE '!'
@ 9,10 GET Tel_wrk PICTURE '999-999-9999'
@ 9,30 GET ext1
@ 9,43 GET tel_hm PICTURE '999-999-9999'
@ 9,64 GET loc1 PICTURE '!!!!!!!!!!'
@ 10,10 GET tel_wrk2 PICTURE '999-999-9999'
@ 10,30 GET ext2
@ 10,43 GET tel_hm2 PICTURE '999-999-9999'
@ 10,64 GET loc2 PICTURE '!!!!!!!!!!'
@ 11,10 GET tel_wrk3 PICTURE '999-999-9999'
@ 11,30 GET ext3
@ 11,43 GET tel_hm3 PICTURE '999-999-9999'
@ 11,64 GET loc3 PICTURE '!!!!!!!!!!'
@ 13,10 GET prof1
@ 13,44 GET birthday PICTURE '99/99/99'
@ 16,10 GET mcom1
@ 17,10 GET mcom2
SET CONSOLE OFF
WAIT TO ANS
STORE UPPER(ANS) TO ANS
SET CONSOLE ON
IF ANS = 'E'
? "                PRESS CONTROL W <^W> WHEN DONE "
READ
CLEAR GETS
STORE 0 TO REC
STORE .F. TO TRUE
ELSE
CLEAR GETS
IF ANS = 'D'
CLEAR
? "               ARE YOU SURE ABOUT THAT (Y OR N) ?"
SET CONSOLE OFF
WAIT TO SURE
SET CONSOLE ON
     IF SURE = 'Y'
          DELETE
      STORE .F. TO TRUE
          STORE 0 TO REC
      STORE .F. TO TRUE
     ELSE
      STORE .F. TO TRUE
          STORE 0 TO REC
          STORE .F. TO TRUE
     ENDIF
ELSE
IF ANS='N'
   SKIP
ELSE
IF ANS = 'P'
   SKIP -1
ELSE
IF ANS = 'M'
     STORE .F. TO TRUE
     STORE 0 TO REC
     STORE .F. TO ED
ELSE
IF ANS = 'F'
     STORE .F. TO TRUE
     STORE 0 TO REC
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO TRUE
ENDDO REC
CLEAR
IF ANS = 'D' .OR. ANS = 'E'
store ' ' to ans1
@ 10,5 SAY "Press 'M' to Return to The Menu"
@ 12,5 Say "Press Any Other Key To Continue"
@ 12,60 get ans1
READ
CLEAR GETS
IF UPPER(ANS1) = 'M'
     STORE .F. TO ED
     CLEAR
     USE
     RETURN
ELSE
CLEAR
ENDIF
ENDIF
ENDDO ED
RETURN
* MAILCAT.PRG PROGRAM FOR VIEWING AND PRINTING MAILING LIST ENTRIES COPYRIGHT
* AUGUST 1985 BY PHILIP K. PERLMAN
PROC MAILCAT
SET TALK OFF
SET HEADING OFF
SET SAFETY OFF
PRIV ANS1
ANS1 = ' '
DO SELECT
  IF ANS1 = 'F'
     STORE "FRIEND='Y'" TO COND1
     PRIV N, VIEW1
     STORE 0 TO N
     STORE ' ' TO VIEW1
     DO PVIEW
     USE MAIL INDEX LAST
     DO PRINT
  ENDIF
IF ANS1 = 'B'
PRIV P
STORE ' ' TO P
DO SELALL
IF UPPER(P) = 'A'
     CLEAR
     PRIV COND1, N, VIEW
     STORE "BUS_XMAS='Y'" TO COND1
     STORE 0 TO N
     STORE ' ' TO VIEW1
     DO PVIEW
     USE MAIL INDEX COMP
     DO PRINT
ENDIF
IF UPPER(P) = 'S'
 STORE .T. TO CONTINUE
 DO WHILE CONTINUE
 SET PRINT OFF
 CLEAR
 PRIVATE CAT
 STORE ' ' TO CAT
 DO CATEG
PRIVATE N, VIEW1
STORE 0 TO N
STORE ' ' TO VIEW1
DO PVIEW
CLEAR
USE MAIL INDEX PROF1
SEEK CAT
CLEAR
STORE 0 TO INDEX
STORE .T. TO TRUE
DO WHILE TRUE
? "&CAT"
? "------------------------------"
IF UPPER(VIEW1) = 'P'
? 'COMPANY','                      ','|', 'NAME', '                          ';
  ,'         ','|','OFFICE TEL. ','|', 'HOME TEL.'
? '=======','                      ','|', '====', '                          ';
  ,'         ','|','=========== ','|', '========='
ENDIF
     DO WHILE .NOT. EOF() .AND. PROF1 = '&CAT' .AND. INDEX < N
? COMPANY,'|', FIRST, LAST,'|', TEL_WRK,'|', TEL_HM
          STORE INDEX +1 TO INDEX
          SKIP
     ENDDO
               IF UPPER(VIEW1) = 'P' .AND. INDEX >= N
                    EJECT
                    STORE 0 TO INDEX
               ENDIF
               IF UPPER(VIEW1) = 'V'
                    WAIT
                    IF INDEX >= N
                         STORE 0 TO INDEX
                    ENDIF
               ENDIF
               IF UPPER(VIEW1)= 'P' .AND. EOF()
                    EJECT
                    ? CHR(18)
                    SET PRINT OFF
                    STORE .F. TO TRUE
               ENDIF
               IF UPPER(VIEW1)= 'V' .AND. EOF()
                    STORE .F. TO TRUE
               ENDIF
               IF PROF1 <> '&CAT'
                    STORE .F. TO TRUE
               ENDIF
ENDDO
CLEAR
STORE ' ' TO CONT
@ 10,5 SAY 'Do you wish to continue ?'
@ 12,5 SAY "Press 'M' to Return to the Menu"
@ 14,5 SAY 'Press any other key to continue'
@ 14,40 GET CONT
READ
CLEAR GETS
IF UPPER(CONT) = 'M'
STORE .F. TO CONTINUE
RETURN
ELSE
DO MAILMSG
ENDIF
ENDDO
ENDIF
ENDIF
*
* SELECT PROGRAM
PROC SELECT
STORE .T. TO BEVEL
DO WHILE BEVEL
CLEAR
STORE ' ' TO ANS1
@ 10,5 say "List <F>riends or <B>usiness ?"
@ 10,35 GET ANS1
READ
CLEAR GETS
STORE UPPER(ANS1) TO ANS1
     IF ANS1 = 'F' .OR. ANS1 = 'B'
     STORE .F. TO BEVEL
ELSE
ENDIF
ENDDO BEVEL
RETURN
*
* SELALL PROGRAM
PROC SELALL
STORE .T. TO RIGHT
DO WHILE RIGHT
STORE ' ' TO P
CLEAR
@ 10,5 SAY "Get <A>ll Categories"
@ 12,5 SAY "Get <S>elected Categories"
@ 12,35 get P
READ
CLEAR GETS
STORE UPPER(P) TO P
IF P = 'A' .OR. P = 'S'
     STORE .F. TO RIGHT
ELSE
ENDIF
ENDDO RIGHT
RETURN
*
* CATEG PROGRAM
PROC CATEG
STORE .T. TO RIGHT1
DO WHILE RIGHT1
STORE '                   ' TO CAT
CLEAR
@ 12,5 SAY "What Category Are You Looking For ?:"
@ 12,42 get CAT
READ
CLEAR GETS
STORE TRIM(UPPER(CAT)) TO CAT
IF CAT <> ' '
STORE .F. TO RIGHT1
ELSE
ENDIF
ENDDO RIGHT1
RETURN
*
* PVIEW.PRG PROGRAM TO SET UP FOR PRINTING OR SCREENING
PROC PVIEW
CLEAR
STORE .T. TO VIEW
     DO WHILE VIEW
     STORE ' ' TO VIEW1
     @ 12,5 SAY " <P>rint the List, <V>iew the List On Screen"
     @ 12,55 GET VIEW1
     READ
     CLEAR GETS
     STORE UPPER(VIEW1) TO VIEW1
     IF VIEW1='P'
     SET PRINT ON
     STORE 60 TO N
     ? CHR(15)
     STORE .F. TO VIEW
     ELSE
     IF VIEW1 = 'V'
     STORE 11 TO N
     STORE .F. TO VIEW
     ELSE
     ENDIF
     ENDIF
     ENDDO VIEW
     RETURN
*
* PRINT.PRG PRINT ROUTINES FOR MAILMEN PROGR.
     PROC PRINT
     CLEAR
     STORE 0 TO INDEX2
     GO TOP
     STORE .T. TO TRUE
     DO WHILE TRUE
          IF UPPER(VIEW1) = 'P'
? 'NAME','                                    ','|', 'COMPANY', '            ';
   ,'         ','|', 'OFFICE TEL. ','|', 'HOME TEL.'
? '====','                                    ','|', '=======', '            ';
   ,'         ','|', '=========== ','|', '========='

           ENDIF
          DO WHILE .NOT. EOF() .AND. INDEX2 < N
               IF &COND1
     ? LAST, FIRST,'|', COMPANY,'|', TEL_WRK,'|', TEL_HM
               STORE INDEX2 +1 TO INDEX2
               ENDIF
               SKIP
     ENDDO .NOT. EOF
                    IF UPPER(VIEW1)= 'P' .AND. INDEX2 >= N
                         EJECT
                         STORE 0 TO INDEX2
                    ENDIF
                    IF UPPER(VIEW1)= 'V'
                         WAIT
                         IF INDEX2 >= N
                              STORE 0 TO INDEX2
                         ENDIF
                    ENDIF
                    IF EOF()
                         STORE .F. TO TRUE
                    ENDIF
     ENDDO TRUE
     EJECT
     ? CHR(18)
     SET PRINT OFF
     RETURN
* MAILROL.PRG PRINTS ROLADEX CARDS FOR MAILMEN PROG. COPYRIGHT NOVEMBER 1,
* 1985 PHILIP K. PERLMAN
PROC MAILROL
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
PRIV ANS1
ANS1= ' '
DO SELECT
@ 10,5 SAY 'Mount 2 1/8" by 4" Roladex Cards in Printer'
@ 12,5 SAY 'Press any key when ready'
SET CONSOLE OFF
wait
set console on
IF UPPER(ANS1) = 'F'
     CLEAR
     USE MAIL INDEX LAST
     GO TOP
     LABEL FORM MAILROL FOR FRIEND='Y'TO PRINT
ENDIF
PRIV P
STORE ' ' TO P
DO SELALL
IF UPPER(P) = 'A'
     CLEAR
     USE MAIL INDEX COMP
     GO TOP
     LABEL FORM MAILROL FOR BUS_XMAS='Y'TO PRINT
ENDIF
IF UPPER(P) = 'S'
STORE .T. TO CONTINUE
DO WHILE CONTINUE
SET PRINT OFF
PRIV CAT
STORE ' ' TO CAT
DO CATEG
CLEAR
STORE UPPER(CAT) TO CAT
USE MAIL INDEX PROF1
FIND &CAT
  LABEL FORM MAILROL WHILE PROF1='&CAT' TO PRINT
CLEAR
STORE ' ' TO CONT
@ 10,5 SAY 'Do you wish to continue ?'
@ 12,5 SAY "Press 'M' to Return to the Menu"
@ 14,5 SAY 'Press any other key to continue'
@ 14,40 GET CONT
READ
CLEAR GETS
IF UPPER(CONT) = 'M'
? CHR(18)
SET PRINT OFF
STORE .F. TO CONTINUE
RETURN
ELSE
DO MAILMSG
ENDDO
ENDIF
ENDIF
RETURN
* MAILAB.PRG COPYRIGHT NOVEMBER 1, 1983 BY PHILIP K. PERLMAN
PROC MAILAB
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
PRIV ANS1
STORE ' ' TO ANS1
DO SELECT
CLEAR
@ 10,5 SAY 'Mount Labels one across by 15/16" high in Printer'
@ 12,5 SAY 'Press any key when ready'
set console off
wait
set console on
IF UPPER(ANS1) = 'F'
     USE MAIL INDEX LAST
     GO TOP
     LABEL FORM MAILAB FOR FRIEND = 'Y' TO PRINT
ENDIF
PRIV P
STORE ' ' TO P
DO SELALL
IF UPPER(P) = 'A'
     CLEAR
     USE MAIL INDEX COMP
     GO TOP
     LABEL FORM MAILAB FOR BUS_XMAS = 'Y' TO PRINT
ENDIF
IF UPPER(P) = 'S'
STORE .T. TO CONTINUE
DO WHILE CONTINUE
SET PRINT OFF
PRIV CAT
STORE ' ' TO CAT
DO CATEG
CLEAR
STORE UPPER(CAT) TO CAT
USE MAIL INDEX PROF1
FIND &CAT
CLEAR
LABEL FORM MAILAB WHILE PROF1='&CAT' TO PRINT
CLEAR
STORE ' ' TO CONT
@ 10,5 SAY 'Do you wish to continue ?'
@ 12,5 SAY "Press 'M' to Return to the Menu"
@ 14,5 SAY 'Press any other key to continue'
@ 14,40 GET CONT
READ
CLEAR GETS
IF UPPER(CONT) = 'M'
? CHR(18)
SET PRINT OFF
STORE .F. TO CONTINUE
RETURN
ELSE
ENDDO
ENDIF
ENDIF
RETURN
* MAILIND.PRG - PRINTS CATEGORIES FOR PROF1 FOR MAILING LIST
* PROGRAM (C) COPYRIGHT DECEMBER 3, 1983 PHILIP K. PERLMAN
PROC MAILIND
SET HEADING OFF
SET SAFETY OFF
CLEAR
SET TALK OFF
STORE 55 TO N
STORE 0 TO INDEX
USE MAIL INDEX COMP
GO TOP
STORE PROF1 TO KEY
SET PRINT ON
STORE .T. TO TRUE
DO WHILE TRUE
?
?
?       "CATEGORIES"
?
DO WHILE .NOT. EOF() .AND. INDEX < N
IF PROF1 <> ' ' .AND. PROF1 <> KEY
? PROF1
STORE INDEX + 1 TO INDEX
STORE PROF1 TO KEY
ENDIF
SKIP
ENDDO
IF INDEX >= N
     EJECT
     STORE 0 TO INDEX
ENDIF
IF EOF()
     STORE .F. TO TRUE
ENDIF
ENDDO
SET PRINT OFF
RETURN
* MAILXMAS.PRG PRINTS CHRISTMAS LABELS FOR MAILING LIST PROGRAM (C) COPYRIGHT
* DECEMBER 3, 1983 BY PHILIP K. PERLMAN
PROC MAILXMAS
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
PRIV ANS1
STORE ' ' TO ANS1
DO SELECT
CLEAR
@ 10,5 SAY 'Mount Labels one across by 15/16" high in Printer'
@ 12,5 SAY 'Press any key when ready'
set console off
wait
set console on
IF UPPER(ANS1) = 'F'
     USE MAIL INDEX PROF1
     LABEL FORM MAILAB SAMPLE TO PRINT FOR FRIEND='Y'
ENDIF
IF UPPER(ANS1) = 'B'
     USE MAIL
     LABEL FORM MAILAB SAMPLE TO PRINT FOR BUS_XMAS='Y'
ENDIF
RETURN
 * MAILBIRT.PRG PRINTS CHRISTMAS LABELS FOR MAILING LIST PROGRAM (C) COPYRIGHT
* DECEMBER 3, 1983 BY PHILIP K. PERLMAN
PROC MAILBIRT
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
USE MAIL INDEX LAST
STORE .T. TO LIST
DO WHILE LIST
STORE ' ' TO LIST1
@ 10,5 SAY "List <A>ll Birthdays or Birthdays for a <S>pecific Month?"
@ 10,65 GET LIST1
READ
CLEAR GETS
  IF UPPER(LIST1) = 'A' .OR. UPPER(LIST1)='S'
    STORE .F. TO LIST
  ELSE
  ENDIF
ENDDO LIST
IF UPPER(LIST1)='A'
CLEAR
STORE .T. TO CHOICE
DO WHILE CHOICE
STORE ' ' TO CHOICE1
@ 10,5 SAY "<L>ist Birthdays on Screen or <P>rint Labels?"
@ 10,52 GET CHOICE1
READ
CLEAR GETS
IF UPPER(CHOICE1)='L' .OR. UPPER(CHOICE1)='P'
   STORE .F. TO CHOICE
ELSE
ENDIF
ENDDO CHOICE
CLEAR
IF UPPER(CHOICE1)='L'
GO TOP
DISPLAY OFF ALL LAST, FIRST, BIRTHDAY FOR BIRTHDAY<> ' '
ENDIF
IF UPPER(CHOICE1)='P'
CLEAR
@ 10,5 SAY 'Mount Labels one across by 15/16" high in Printer'
@ 12,5 SAY 'Press any key when ready'
set console off
wait
set console on
CLEAR
LABEL FORM MAILAB SAMPLE TO PRINT FOR BIRTHDAY<>' '
ENDIF
ENDIF
IF UPPER(LIST1)='S'
CLEAR
STORE '  ' TO DAY
@ 10,5 SAY "List Birthdays for the Month Numbered >"
@ 10,45 GET DAY PICTURE '99'
READ
CLEAR GETS
STORE VAL(DAY) TO DAY1
STORE DAY-'/11/11' TO DATE
GO TOP
CLEAR
DISPLAY OFF ALL LAST, FIRST, BIRTHDAY FOR VAL(BIRTHDAY)=DAY1
WAIT
CLEAR
* STR.PRG TAKES SPACES FROM BEGINNING OF STRING AND PLACES THEM AT END
DO WHILE SUBSTR(DATE,1,1)=' ' .AND. LEN(DATE)>1
  DATE=SUBSTR(DATE,2)+ " "
ENDDO
STORE CMONTH(CTOD(DATE)) TO PHRASE
STORE ' ' TO CONTIN
@ 10,5 SAY "Do You Wish To Print Labels for Birthdays in:"
@ 10,52 SAY PHRASE
@ 12,5 SAY "Press <Y> for Labels, Any Other Key To Quit"
@ 12,52 GET CONTIN
READ
CLEAR GETS
IF UPPER(CONTIN) = 'Y'
CLEAR
@ 10,5 SAY 'Mount Labels one across by 15/16" high in Printer'
@ 12,5 SAY 'Press any key when ready'
set console off
wait
set console on
CLEAR
GO TOP
     LABEL FORM MAILAB SAMPLE TO PRINT FOR VAL(BIRTHDAY)=DAY1
ELSE
ENDIF
ENDIF
RETURN
* MAILSET.PRG SETS THE DEFAULT DRIVES FOR MAILMEN.PRG COPYRIGHT JULY 30,
* 1985 BY PHILIP K. PERLMAN
PROC MAILSET
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
store .t. to go
do while go
CLEAR
RESTORE FROM MAILSET ADDITIVE
store ' ' to change
@ 10,5 Say "The Drive <A,B,C, or D> for Database Files is " get drv
@ 12,5 SAY "Should the Bell be On <Y> or <N>? "get bell
@ 14,5 say "<M>onochrome or <C>olor. Currently it is " get color
@ 16,5 SAY "Path to Search for Database Files is ";
 GET MPATH PICTURE "XXXXXXXXXXXXXXXXXXXX"
?
?
? "Press <C> If You Wish To <C>hange These Defaults"
?
? "Press <M>enu To Leave Unchanged"
set console off
wait to change
set console on
store UPPER(change) to change
   if change = 'C'
      read
      CLEAR GETS
      STORE UPPER(DRV) TO DRV1
      STORE UPPER(BELL) TO BELL1
      STORE UPPER(COLOR) TO COLOR1
      STORE UPPER(MPATH) TO MPATH
         IF DRV ='A'.OR. DRV ='B'.OR. DRV ='C'.OR. DRV= 'D'
            STORE DRV1 to DRV
         ELSE
            LOOP
         ENDIF
         IF BELL1 ='Y' .OR. BELL1= 'N'
            STORE BELL1 TO BELL
           IF BELL='Y'
                  STORE 'ON' TO BEEP
               ENDIF
               IF BELL='N'
                  STORE 'OFF' TO BEEP
               ENDIF
         ELSE
            LOOP
         ENDIF
         IF COLOR ='C'.OR. COLOR ='M'
            STORE COLOR1 TO COLOR
               IF COLOR='M'
                  STORE "+7/0,0/+7,0" TO COLR
               ENDIF
               IF COLOR ='C'
                  STORE "+7/1,+6/0,0" TO COLR
               ENDIF
         ELSE
            LOOP
         ENDIF
   RELEASE DRV1, BELL1, COLOR1
   SAVE TO MAILSET
   STORE .F. TO GO
ELSE
   IF CHANGE='M'
      STORE .F. TO GO
   ENDIF
ENDIF
ENDDO GO
RETURN
* MAILDEL.PRG PROGRAM FOR PURGING RECORDS MARKED FOR DELETION IN MAILMEN
* PROGRAM COPYRIGHT APRIL 26, 1985 BY PHILIP K. PERLMAN
PROC MAILDEL
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
@ 10,20 SAY "...Examining Files..."
USE MAIL INDEX LAST,COMP, PROF1
STORE 0 TO purg
go top
do while .not. EOF()
if last = ' ' .and. first =' '.and. company =' '
@ 10,20 say "...Purging..."
dele
store 1 to purg
else
@ 10,20 say "...Examining Files..."
endif
if DELETE()
store 1 to purg
endif
skip
enddo
IF purg =1
PACK
ELSE
CLEAR
@ 10,5 SAY "THERE ARE NO RECORDS TO BE PURGED."
@ 12,5 SAY "PRESS ANY KEY TO RETURN TO THE MENU"
SET CONSOLE OFF
WAIT
SET CONSOLE ON
ENDIF
RETURN
* MAILMSG.PRG  COPYRIGHT AUGUST 9, 1985 BY PHILIP K. PERLMAN
PROC MAILMSG
CLEAR
STORE REMIND +1 TO REMIND
   IF REMIND=5
      CLEAR
    TEXT
   **********************************************************************
   *   This program is being distributed under the "Shareware Concept." *
   *   It represents many hours of work. You are encouraged to use      *
   *   this program and share it with others. If you find it useful, a  *
   *   small contribution of $20 would be appreciated. Upon receipt of  *
   *   your contribution we will send you the latest version with this  *
   *   message removed.                                                 *
   *                         Philip K. Perlman                          *
   *                         116 West 29th Street                       *
   *                         NYC, NY 10001                              *
   *                                                                    *
   **********************************************************************
    ENDTEXT
    STORE .T. TO TIME
        STORE 0 TO TEST
    STORE 0 TO TEST1
        STORE "* WAIT *" TO MSG
    DO WHILE TIME
          STORE TEST+1 TO TEST
          STORE TEST1+1 TO TEST1
            IF TEST=50
               STORE .F. TO TIME
            ENDIF
            IF TEST1 = 2
               @ 11,32 GET MSG
               CLEAR GETS
               STORE 0 TO TEST1
            ENDIF
            IF TEST1=1
               @ 11,32 SAY "* WAIT *"
            ENDIF
        ENDDO
RELEASE TIME, TEST, TEST1, MSG
STORE 0 TO REMIND
ENDIF
RETURN